home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MAIL.SWG / 0009_Read SWG or QWK Files.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  3KB  |  127 lines
  1. {$V-,S-}
  2. { this SIMPLE little ditty let's you read SWAG or QWK files which have
  3.   EXACTLY the same format }
  4. Program ReadQWKORSWAGFile;
  5.  
  6. Uses
  7.   Crt;
  8.  
  9. Const
  10.   Seperator = '---------------------------------------------------------------------------';
  11.  
  12. Type
  13.  
  14.   CharArray = ARRAY[1..6] OF CHAR;  { to read in chunks }
  15.  
  16.   MSGDATHdr = Record  { ALSO the format for SWAG files !!! }
  17.     Status   : Char;
  18.     MSGNum   : Array [1..7] of Char;
  19.     Date     : Array [1..8] of Char;
  20.     Time     : Array [1..5] of Char;
  21.     UpTO     : Array [1..25] of Char;
  22.     UpFROM   : Array [1..25] of Char;
  23.     Subject  : Array [1..25] of Char;
  24.     PassWord : Array [1..12] of Char;
  25.     ReferNum : Array [1..8] of Char;
  26.     NumChunk : CharArray;
  27.     Alive    : Byte;
  28.     LeastSig : Byte;
  29.     MostSig  : Byte;
  30.     Reserved : Array [1..3] of Char;
  31.   end;
  32.  
  33. Var
  34.   F           : File;
  35.   DefSaveFile : String;
  36.   Number      : Word;
  37.  
  38. FUNCTION ArrayTOInteger(B : CharArray; Len : BYTE) : LONGINT;
  39.  
  40. VAR I : Byte;
  41.     S : STRING;
  42.     E  : Integer;
  43.     T  : Integer;
  44.  
  45. BEGIN
  46.     S := '';
  47.     FOR I := 1 TO PRED(Len) DO IF B[i] <> #32 THEN S := S + B[i];
  48.     Val (S, T, E);
  49.     IF E = 0 THEN ArrayToInteger := T;
  50. END;
  51.  
  52. Procedure ReadMSG (NumChunks : INTEGER);
  53. Var
  54.   Buff : Array [1..128] of Char;
  55.   J    : INTEGER;
  56.   I    : Byte;
  57.  
  58. begin
  59.   For J := 1 to PRED(NumChunks) do
  60.   begin
  61.     BlockRead (F, Buff, 1);
  62.     For I := 1 to 128 do
  63.       If Buff [I] = #$E3 then
  64.         Writeln
  65.       else
  66.         Write (Buff [I]);
  67.   end;
  68. end;
  69.  
  70. Procedure ReadWriteHdr (Var HDR : MSGDatHdr);
  71. begin
  72.   BlockRead (F, Hdr, 1);
  73.   With Hdr do
  74.   begin
  75.     Write ('Date: ', Date, ' (', Time, ')');
  76.     Writeln ('' : 23, 'Number: ', MSGNum);
  77.     Write ('From: ', UpFROM);
  78.     Writeln ('' : 14, 'Refer#: ', ReferNum);
  79.     Write ('  To: ', UpTO);
  80.     Write ('' : 15, 'Recvd: ');
  81.     If Status in ['-', '`', '^', '#'] then
  82.       Writeln ('YES')
  83.     else
  84.       Writeln ('NO');
  85.     Write ('Subj: ', Subject);
  86.     Writeln ('' : 16, 'Conf: ', '(', LeastSig, ')');
  87.     Writeln(Seperator);
  88.   end;
  89. end;
  90.  
  91. Procedure ReadMessage (HDR : MSGDatHdr; RelNum : LONGINT; VAR Chunks : INTEGER);
  92. begin
  93.   Seek(F,RelNum-1);
  94.   ReadWriteHdr (HDR);
  95.   Chunks := ArrayToInteger(HDR.NumChunk,6);
  96.   ReadMsg (Chunks);
  97. end;
  98.  
  99. Var
  100.   MSGHdr   : MSGDatHdr;
  101.   REPorDAT : Boolean;
  102.   ch       : CHAR;
  103.   count    : INTEGER;
  104.   chunks   : INTEGER;
  105.  
  106. begin
  107.  
  108.   DefSaveFile := '';
  109.   DirectVideo := False;
  110.   Assign (F, '\SWAG\FILES\EGAVGA.SWG'); { whatever file ..    }
  111.                                         { MESSAGES.DAT for .QWK}
  112.   Reset (F, SizeOf(MsgHdr));
  113.   Count := 2;  { start at RECORD #2 }
  114.   WHILE (Count < FileSize(F)) DO
  115.         BEGIN
  116.         ClrScr;
  117.         ReadMessage (MSGHdr, Count, Chunks);
  118.         Writeln;
  119.         WriteLn('..any key to continue .. (any FN Key quits)');
  120.         ch := Readkey;  { any FN key quits }
  121.         IF Ch = #0 THEN HALT;
  122.         INC(Count,Chunks);
  123.         END;
  124.   Close (F);
  125.  
  126. end.
  127.